perm filename MOVE.FAI[NEW,LCS]15 blob sn#502589 filedate 1980-04-19 generic text, type T, neo UTF8
00100		TITLE	MOVE
00200		ENTRY	GETPTS,MOVIT,COPYIT,STFCH,DELETE
00300	;	ENTRY SLEND,POSIT,NOTAIL
00400		EXTERNAL LOOP,RTLINE,DL,DPY,DPYNEW,.COMM.,XRN,KJY,PTR,POSI
00500		EXTERNAL SCM,AMOD,RMOD,RINP,DPTR,LIMIT,OUTLIM
00600	
00700	  K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00800	
00900	; 	SUBROUTINE GETPTS
01000	;	DIMENSION N(500),NP(500)
01100	;	COMMON/XRN/RN(4000)  /KJY/ K,J
01200	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
01300	;	1/PTR/PWDS(250),ITEM,LL,I,IX
01400	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
01500	;	1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
01600	
01700	GETPTS:	0		;CALL GETPTS(N)
01800		SETZ	J,	;	J=0
01900		SETZ	K,	;	K=0
02000		MOVE 	JJ2,POSI+=8
02100		MOVE R2,.COMM.
02200		MOVE	X,@(16)
02300		SOS	X
02400		MOVEI	M,PTR	;	DO 1 M=1,ITEM
02500		ADDI	M,(X)
02600	G1:	AOJ	X,
02700		MOVE	L,(M)
02800		MOVEI	R,XRN(L)	;L=PWDS(M)
02900		MOVE	1,1(R)		;RN(L+2)
03000		CAML	R2,[=8.0]	;IF R2.GE.8 LOOK AT ALL STAVES
03100		JRST	GZ
03200		CAME	R2,1	
03300		JRST 	GX
03400	GZ:	MOVE	A,.COMM.+7		;RY=RN(L+1)
03500		JUMPLE	A,G9			;F(R6.LE.0)GO TO 9
03600		CAME	A,(R)
03700		JRST	GX
03800	;  CHECK CODE NUM
03900	G9:	MOVE	A,2(R)		;IF(R6.NE.RY)GO TO 1
04000		CAMG	A,.COMM.+6	;9	IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
04100		CAMGE	A,.COMM.+5	;R4
04200		JRST	G2
04300	
04400		CAMLE JJ2,X
04500		MOVE	JJ2,X		;IF(M.LT.JJ2)JJ2=M
04600		AOJ	J,
04700	;  IN LIMITS?
04800		MOVEI	A,RINP+=499(J)	;J=J+1
04900		MOVEI	0,(L)
05000		AOJ	K,		;K=K+1
05100		MOVEI	1,RINP+=849(K)
05200		MOVEM	0,(1)
05300		ADDI	0,3		;N(J)=L+3
05400		MOVEM	0,RINP+=499(J)
05500	;  NP IS FOR USE IN JUSTIFY ROUTINE
05600	G2:	MOVE	RY,(R)		;2	IF(RY.EQ.2)GO TO GRST
05700		CAMN	RY,[2.0]	;IF(RY.LT.4)GO TO 1
05800		JRST GRST
05900		CAML	RY,[=4.0]
06000		CAMLE	RY,[=7.0]
06100		JRST	GX		;IF(RY.GT.7)GO TO 1
06200	;  TWO-ENDED ITEM?
06300		MOVE	RZ,-1(R)	;RZ=RN(L)
06400	;  WD CNT
06500		KIFIX RY,RY
06600		XCT TBL-4(RY)	; NEXT REPLACES THE ABOVE.
06700		JRST G5
06800		JRST GX
06900	TBL:	JRST G4
07000		JRST G5
07100		JRST G6
07200		CAMG RZ,[4.0]
07300	
07400	G4:	CAMG	RZ,[=3.0]	;7	IF(RZ.GT.3)GO TO 5
07500		JRST	GX
07600		JRST	G5		;GO TO 1
07700	GRST:	MOVE RZ,-1(R)		;FOR 'CENTERED' RESTS
07800		JRST G8
07900	G6:	CAMGE	RZ,[=8.0]	;6	IF(RZ.LT.8)GO TO 8
08000		JRST	G8
08100		SKIPL 6(R)	;IF(R7)GO TO 8
08200		SKIPN =9(R)	;IF(R10.EQ.0)GO TO 8
08300		JRST	G8	 ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
08400		SKIPG A,7(R)		;IGNORE P8 IF IT IS 0 OR -
08500		JRST G8
08600		CAMG	A,.COMM.+6
08700		CAMGE	A,.COMM.+5
08800		JRST	G8
08900		CAMLE JJ2,X
09000		MOVE	JJ2,X
09100		AOJ	J,
09200	;  IN LIMITS?
09300		MOVEI	0,=8(L)		;J=J+1
09400		MOVEM 0,RINP+=499(J)
09500	G8:	CAML	RZ,[=7.0]	;8	IF(RZ.LT.7)GO TO 5
09600		SKIPG A,8(R)	; R9    IF(R9.LE.0)GO TO G5
09700		JRST G5
09800		CAME RY,[2.0]	;IF(RY.EQ.2)GO TO GRST2 (NEW REST CENTERING)
09900		SKIPE 7(R)	; R8     USE R9 IF R9<0 AND (R8≠0 OR R7<0)
10000		JRST GRST2
10100		SKIPL 6(R)	; R7
10200		JRST G5
10300	GRST2:	CAMG	A,.COMM.+6
10400		CAMGE	A,.COMM.+5	;R4
10500		JRST	G5
10600	
10700		CAMLE JJ2,X
10800		MOVE	JJ2,X
10900		AOJ	J,		;J=J+1
11000	;  IN LIMITS?
11100		MOVEI	0,=9(L)
11200		MOVEM 0,RINP+=499(J)
11300	G5:	CAMN	RY,[2.0]	;IF(RY.EQ.2)GO TO 1
11400		JRST GX  
11500		MOVE	A,5(R)
11600		CAMG	A,.COMM.+6
11700		CAMGE	A,.COMM.+5	;R4
11800		JRST	GX
11900	
12000		CAMLE JJ2,X
12100		MOVE	JJ2,X
12200		AOJ	J,
12300	;  IN LIMITS?
12400		MOVEI	0,6(L)  ;5	IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
12500		MOVEM 0,RINP+=499(J)
12600	GX:	CAMGE	X,LIMIT+1	;1	CONTINUE
12700	;;GX:	CAMGE	X,PTR+=250	;1	CONTINUE
12800		AOJA	M,G1
12900		MOVEM	JJ2,POSI+=8
13000		MOVEM	J,KJY+1
13100		MOVEM	K,KJY
13200		JRA	16,1(16)
13300	
13400	
13500	;	SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
13600	;	DIMENSION  NP(1),RN(1)
13700	;	COMMON  /KJY/ DONT,J
13800	MOVIT:	0		;RDIS=(R9-R8)/(R5-R4)
13900		MOVE	R,@5(16)    
14000		FSBR	R,@4(16)    
14100		MOVE	RY,@3(16)   
14200		FSBR	RY,@2(16)   
14300		FDVR	R,RY
14400	;	MOVEI	L,XRN+=2499	;	DO 1 K=1,J
14500		MOVEI	L,@1(16)		; GET NP ARRAY LOC
14600		SETZ	K,
14700		MOVE	0,@5(16)     	; SET UP R9
14800	;;M1:	MOVE	X,L	       ;	L=NP(K)
14900	M1:	MOVEI  	R2,@(16)	;RA=RN(L)
15000		ADD 	R2,(L)
15100		MOVEI	RZ,(R2)
15200		MOVE	R2,-1(R2)
15300		CAML	R2,@2(16)   	;IF(OUTLIM(R4,R5,RA))GO TO 1
15400		CAMLE	R2,@3(16)   
15500		JRST	MX
15600		JUMPE	0,M2	;IF(R9.NE.0)RA=(RA-R4)*RDIS
15700		FSBR	R2,@2(16)   
15800		FMPR	R2,R 
15900	M2: 	FADR	R2,@4(16)    	;	RN(L)=R8+RA
16000		MOVEM	R2,-1(RZ)
16100	MX:	AOJ	K,		;1	CONTINUE
16200		CAMGE	K,KJY+1
16300		AOJA	L,M1
16400		JRA	16,6(16)
16500	
16600	;***** COPYIT
16700	;;	TITLE COPYIT
16800	;	SUBROUTINE COPYIT
16900	;	COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
17000	;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
17100	;	1/PTR/PWDS(250),ITEM,LL,I,IX
17200	;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
17300	;	1,(R6,RJQ(4)),(N,RN(2500))
17400	STFCH:	0
17500		SETO 13,	;FLAG FOR STFCH ROUTINE
17600		JRST .+3
17700	
17800	COPYIT:	0
17900		SETZ 13,	;MAKE SURE IT'S 0
18000		SETZ 7,		;IM=ITEM
18100		MOVE 15,LIMIT+1 	; AC7 IS K-1
18200	;;	MOVE 15,PTR+=250 	; AC7 IS K-1
18300		SOJ 15,		;(ITEM-1)
18400	CP1:	JSA 16,RTLINE	;DO 1 K=1,IM
18500		JUMP PTR(7)	;L=PWDS(K)
18600		JUMPL CPY	;	IF(RTLINE(L))GO TO 1
18700		JSA 16,OUTLIM	;IF(OUTLIM(L,3))GO TO 1
18800		JUMP PTR(7)
18900		JUMP [3]
19000		JUMPL CPY
19100		MOVE 11,PTR(7)	; NOW L IS AC11
19200		MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
19300		JUMPE 10,CP3
19400		CAME 10,XRN(11)
19500		JRST CPY
19600	CP3:	JUMPL 13,STF2	; SKIP OVER FOR STFCH ROUTINE
19700		KIFIX 12,XRN-1(11)	;M=RN(L)+2
19800		ADDI 12,2
19900		JSA 16,LOOP	;CALL LOOP(0,M,1,I,L,RN)
20000		JUMP [0]
20100		JUMP 12
20200		JUMP [1]
20300	;;	JUMP PTR+=252
20400		JUMP LIMIT+3 
20500		JUMP 11
20600		JUMP XRN
20700		AOS LIMIT+1	;ITEM=ITEM+1
20800	;;	AOS PTR+=250	;ITEM=ITEM+1
20900	;;	MOVE 13,PTR+=250
21000		MOVE 13,LIMIT+1
21100		MOVE 11,PTR-1(13)	;L=PWDS(ITEM)
21200	STF2:	MOVE 14,.COMM.+=8	;RN(L+2)=R7
21300		CAMG 14,[7.0]		;R7 > 7 = DON'T CHANGE STAFF NUM.
21400		MOVEM 14,XRN+1(11)
21500		JUMPGE 13,CP2
21600		MOVE 0,7
21700		AOJ
21800		CAMGE POSI+=8
21900		MOVEM POSI+=8	; IF(K.LT.JJ2)JJ2=K
22000		JRST CPY
22100	CP2:	CAMGE 13,POSI+=8	;IF(ITEM.LT.JJ2)JJ2=ITEM
22200		MOVEM 13,POSI+=8
22300		AOJ 12,	;I=I+M+1
22400		ADD 12,LIMIT+3 
22500		MOVEM 12,LIMIT+3  
22600		MOVEM 12,PTR(13)	;PWDS(ITEM+1)=I
22700	CPY:	CAMGE 7,15	;1 CONTINUE
22800		AOJA 7,CP1
22900		JUMPL 13,.+3
23000		MOVE 7,.COMM.+=8	;R2=R7
23100		MOVEM 7,.COMM.		;DOES THIS MATTER FOR STFCH}
23200		JRA 16,(16)	;END
23300	
23400		;SUBROUTINE STFCH
23500		;INTEGER PWDS
23600		;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
23700		;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
23800		;1/PTR/PWDS(250),ITEM,LL,I,IX
23900		;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
24000		;DO 1 K=1,ITEM
24100		;L=PWDS(K)
24200		;IF(RTLINE(L))GO TO 1
24300		;IF(OUTLIM(L,3))GO TO 1
24400		;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
24500	;C DIDN'T MATCH THE CODE NUM.
24600		;IF(JJ2)JJ2=K
24700		;RN(L+2)=R7
24800	;1	CONTINUE
24900		;END
25000	
25100		;SUBROUTINE DELETE
25200		;IMPLICIT INTEGER(A-Q,S-Z)
25300		;COMMON/DL/X22,SAVER,NAME
25400		;COMMON /XRN/RN(4000)
25500		;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
25600		;COMMON/PTR/PWDS(250),ITEM,L,I,IX
25700		;COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
25800	DELETE:	0	;EQUIVALENCE (ST2,ST(2))
25900		MOVE 15,LIMIT+3  
26000		MOVEM 15,LIMIT+4  
26100	;;	MOVE 15,PTR+=252
26200	;;	MOVEM 15,PTR+=253
26300		MOVE 12,DPY+=4000	;171	IX=I   15 IS IX
26400		KIFIX 14,XRN-1(12)	;L=RN(MEDIT)+3.0
26500		ADDI 14,3	;AC14 IS L
26600	;  SIZE OF DELETION
26700		SUB 15,14	;I=IX-L
26800		MOVEM 15,LIMIT+3   
26900	;;	MOVEM 15,PTR+=252
27000		JSA 16,LOOP	;CALL LOOP(MEDIT,I,1,0,L,RN)
27100		JUMP DPY+=4000
27200		JUMP LIMIT+3  
27300	;;	JUMP PTR+=252
27400		JUMP [1]
27500		JUMP [0]
27600		JUMP 14 
27700		JUMP XRN
27800		MOVE 7,DL	;JY=WDS(X22+1)-WDS(X22)
27900		MOVE 13,DPTR(7)
28000	;;	MOVE 13,DPY+=4000(7)
28100	;;	SUB 13,DPY+=3999(7)	;JY IS 13, X22 IS 7
28200		SUB 13,DPTR-1(7)	;JY IS 13, X22 IS 7
28300		MOVEI 10,2
28400		ADD 10,DPTR-1(7)	;WDS(X22)+2
28500		MOVE 15,LIMIT+1	;15 IS ITEM  (X)
28600		JSA 16,LOOP	;CALL LOOP(WDS(X22)+2,WDS(X),1,0,JY,ST)
28700		JUMP 10
28800		JUMP DPTR-1(15)
28900	;;	JUMP DPY+=3999(15)
29000		JUMP [1]
29100		JUMP [0]
29200		JUMP 13 
29300		JUMP DPY
29400		MOVE 12,7	;K=X22
29500	DELE:	MOVE 11,12	;194	 N=K+1
29600		AOJ 11,		;N IS 11   K IS 12
29700		MOVE 2,DPTR(11)	;WDS(N)=WDS(N+1)-JY
29800		SUB 2,13
29900		MOVEM 2,DPTR-1(11)
30000		MOVE 2,PTR-1(11)	;PWDS(K)=PWDS(N)-L
30100		SUB 2,14
30200		MOVEM 2,PTR-1(12)
30300		MOVE 12,11	;K=N
30400		CAMGE 12,15	;IF(K.LT.X)GO TO 194
30500		JRST DELE	;  ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
30600		SOS LIMIT+1	;ITEM=ITEM-1
30700		MOVE 2,LIMIT+1
30800		CAMLE 7,LIMIT+1	;IF(X22.GT.ITEM)X22=ITEM
30900		MOVEM 2,DL
31000		MOVEM 2,.COMM.+2	;J2=ITEM
31100		SOS LIMIT+1	;ITEM=ITEM-1
31200		MOVE 2,DPTR-1(2)	;ST2=WDS(J2)
31300		MOVEM 2,DPY+1
31400		JSA 16,DPYNEW		;271	CALL DPYNEW
31500		JRA 16,(16)
31600	
31700	;SLEND:	0	;	SUBROUTINE SLEND
31800	;	MOVE 8,[8.0]	;INTEGER PWDS
31900	;	MOVE 7,SCM+=80	;C  TO FIND END POINTS OF STAVES
32000	;	MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
32100	;;	1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
32200	;; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
32300	;	SETZ 5,		;DO 1 K=1,ITEM
32400	;SLN1:	MOVE 6,PTR(5)	;L=PWDS(K)
32500	;			;IF(RN(L+1).NE.8)GO TO 1
32600	;	CAMN 8,XRN(6)	;C  FOUND A STAFF  ;IF(RN(L+2).NE.STAFF)GO TO 1
32700	;	CAME 7,XRN+1(6)	;C GOT THE RIGHT ONE
32800	;	JRST SLN1X	;IF(IT)GO TO 2
32900	;	SKIPGE RMOD+=10 	;POS=202
33000	;	JRST SLN2	;C NOW CHECK LEFT SIDE OF STAFF
33100	;	MOVSI 15,210624	;[202.0]	;IF(RN(L).LT.4)RETURN
33200	;	CAML 4,XRN-1(6)	;P6 WASN'T MENTIONED - SO IT =200
33300	;	JRST SLN3
33400	;			;POS=RN(L+6)+2
33500	;	MOVE 15,XRN+5(6)	;IF(POS.EQ.2)POS=202
33600	;	FADR 15,[2.0]	;RETURN
33700	;	CAMN 15,[2.0]	;2 	POS=RN(L+3)-2.3
33800	;	MOVSI 15,210624	;[202.0]	;RETURN
33900	;	JRST SLN3	;1	CONTINUE
34000	;SLN2:	MOVE 15,XRN+2(6)	;END
34100	;	FSBR 15,[2.3]
34200	;SLN3:	MOVEM 15,RMOD+=11 
34300	;	JRA 16,(16)
34400	;SLN1X:	AOS 5
34500	;	CAMGE 5,LIMIT+1
34600	;	JRST SLN1
34700	;	SKIPLE RMOD+=11		;IF(POS.LE.0)RETURN
34800	;	JRST SLN2-2		;POS=202 (IN CASE THERE IS NO STAFF)
34900	;	JRA 16,(16)		;END
35000	
35100	;POSIT:	0	;	FUNCTION POSIT(V)
35200	;	MOVE 15,@(16)	;	COMMON/XRN/RN(4000)
35300	;	SKIPGE 15	;	DIMENSION POSNT(0/82)
35400	;	MOVNS 15	;	EQUIVALENCE (POSNT,RN(3801))
35500		           	;	1,(A,RN(3884)),(K,RN(3885))
35600	;	KIFIX 14,15	;	IF(V)V=-V
35700	;  REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
35800	;	JSA 16,AMOD	;	K=V
35900	;	JUMP 15		;	A=POSNT(K)
36000	;	JUMP [1.0]	;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
36100	; TYPE  /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
36200	;	MOVE 2,RINP+=851(14)	;	END
36300	;	FSBR 2,RINP+=850(14)
36400	;	FMPR 0,2
36500	;	FADR 0,RINP+=850(14)
36600	;	JRA 16,1(16)
36700		
36800	;NOTAIL:	0		;FUNCTION NOTAIL(X)
36900	;	SETZ		;NOTAIL=0
37000	;	MOVM 2,@(16)	;X=ABS(X)
37100	;	CAML 2,[0.56]	;IF(X.LT..56.OR.X.EQ..75)RETURN
37200	;	CAMN 2,[0.75]
37300	;	JRA 16,1(16)
37400	;	CAME 2,[0.875]	;IF(X.EQ..875.OR.X.EQ..6)RETURN (8.. OR 10. )
37500	;	CAMN 2,[0.6]
37600	;	JRA 16,1(16)
37700	;	SETO		;NOTAIL=-1
37800	;	JRA 16,1(16)
37900		END